home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / apg_2.exe / PRINT.SKL < prev    next >
Encoding:
Text File  |  1993-03-16  |  4.8 KB  |  232 lines
  1. DEFINT A-Z
  2. DECLARE SUB box ()
  3. DECLARE SUB header ()
  4. DECLARE SUB sortindex ()
  5. XX DECLARE SUB total ()
  6. XX DECLARE SUB subtotal ()
  7. TYPE rectype                                'Define variables for file
  8. XX    inbr AS STRING * 10
  9. XX    desc AS STRING * 30
  10. XX    ucost AS DOUBLE
  11. XX    lprice AS DOUBLE
  12. XX    group AS STRING * 7
  13.    sts AS STRING * 1
  14. END TYPE
  15. TYPE indextype                              'Define index
  16.    recnum AS INTEGER
  17. XX    sort AS STRING * 37
  18. END TYPE
  19. DIM SHARED pline
  20. DIM SHARED page
  21. DIM SHARED numofrec
  22. XX DIM SHARED f5.2$
  23. XX DIM SHARED f6.2$
  24. XX DIM SHARED f8.2$
  25. XX DIM SHARED Tlprice#
  26. XX DIM SHARED Slprice#
  27. XX DIM SHARED item AS rectype
  28. XX f5.2$ = "######.##"
  29. XX f6.2$ = "#######.##"
  30. XX f8.2$ = "#########.##"
  31.  
  32. ON ERROR GOTO errhandle
  33.  
  34. XX OPEN "ITEM.DAT" FOR RANDOM AS #1 LEN = LEN(item)
  35.  
  36. XX numofrec = LOF(1) \ LEN(item)
  37. IF numofrec = 0 THEN
  38.    CLS
  39.    PRINT "You have to build the Data Base first."
  40.    INPUT "", a$
  41.    GOTO fina
  42. END IF
  43. DIM SHARED index(1 TO numofrec)  AS indextype
  44. FOR i = 1 TO numofrec
  45. XX    GET #1, i, item
  46.    index(i).recnum = i
  47. XX index(i).sort = item.group + item.desc
  48. NEXT i
  49.  
  50. COLOR , 1
  51. CLS
  52. COLOR 4, 1
  53. LOCATE 1, 25
  54. PRINT STRING$(30, 220)
  55. LOCATE 2, 24
  56. COLOR , 0
  57. PRINT " ";
  58. COLOR 0, 3
  59. PRINT STRING$(30, " ")
  60. XX LOCATE 2, 32
  61. XX COLOR 0, 3: PRINT "PARTS COST LIST"
  62. LOCATE 3, 24
  63. COLOR , 0: PRINT STRING$(30, " ")
  64.  
  65. COLOR 7, 1
  66. LOCATE 5, 26
  67. PRINT "Date: "; DATE$; "    "; TIME$
  68. LOCATE 6, 26
  69. XX PRINT "Program name:       "; "itemprt"
  70. LOCATE 7, 26
  71. XX PRINT "Datafile name:      "; "item.dat"
  72. LOCATE 8, 26
  73. PRINT "Number of records: "; numofrec
  74.  
  75. box
  76. COLOR 0, 3
  77. LOCATE 11, 26
  78. PRINT "Please check to see that the"
  79. LOCATE 12, 26
  80. PRINT "printer has paper and is "
  81. LOCATE 13, 26
  82. PRINT "on-line.  A)bort, or <ENTER>"
  83.  
  84. DO
  85. a$ = INKEY$
  86. LOOP WHILE a$ = ""
  87. IF UCASE$(a$) = "A" GOTO fina
  88.  
  89. box
  90. LOCATE 12, 27
  91. PRINT "Sorting file - Please wait"
  92. sortindex
  93. box
  94.  
  95. first$ = "F"
  96. FOR i = 1 TO numofrec
  97. IF pline <= 0 THEN
  98.    IF first$ = "" THEN LPRINT CHR$(12)
  99.    header
  100. END IF
  101. XX GET #1, index(i).recnum, item
  102. XX IF item.sts = "D" THEN GOTO nex
  103. XX IF first$ = "" THEN
  104. XX    IF (item.group) <> group$ THEN
  105. XX subtotal
  106. XX Slprice# = 0
  107. XX    END IF
  108. XX END IF
  109. XX LPRINT TAB(2); item.inbr;
  110. XX LPRINT TAB(14); item.group;
  111. XX LPRINT TAB(23); item.desc;
  112. XX LPRINT USING f6.2$; TAB(57); item.lprice;
  113. XX LPRINT USING f5.2$; TAB(69); item.ucost
  114.  
  115. a$ = INKEY$
  116. IF a$ = CHR$(27) THEN GOTO fin
  117.  
  118. first$ = ""
  119. pline = pline - 1
  120. XX Tlprice# = Tlprice# + item.lprice
  121. XX Slprice# = Slprice# + item.lprice
  122. XX group$ = item.group
  123. nex:
  124. NEXT i
  125. XX subtotal
  126. XX total
  127. fin:
  128.  
  129. XX LPRINT CHR$(18);                             'Reset from condensed
  130. LPRINT CHR$(12);                                'Form Feed
  131. fina:
  132. COLOR 7, 1
  133. CLS
  134. CLOSE
  135. XX RUN "zmenu"
  136. END
  137.  
  138. errhandle:
  139. IF ERR = 25 THEN
  140.    box
  141.    LOCATE 12, 32
  142.    PRINT "Printer Not ready"
  143.    LOCATE 13, 32
  144.    PRINT "Abort or Retry "
  145.    DO
  146.       a$ = INKEY$
  147.    LOOP WHILE a$ = ""
  148.    IF UCASE$(a$) = "R" THEN
  149.       box
  150.       LOCATE 12, 32
  151.       PRINT "Printing Page:"; page
  152.       LOCATE 13, 32
  153.       PRINT "<Escape> to cancel"
  154.       RESUME
  155.    ELSE
  156.       GOTO fina
  157.    END IF
  158. ELSE
  159.    CLS
  160.    PRINT "Unexpected error number"; ERR
  161.    PRINT "Please consult your Quickbasic Manual"
  162.    INPUT "", a$
  163.    GOTO fina
  164. END IF
  165.  
  166. SUB box
  167. COLOR 4, 1
  168. LOCATE 10, 25
  169. PRINT STRING$(30, 220)
  170. COLOR 9, 7
  171. LOCATE 11, 24
  172. COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
  173. LOCATE 12, 24
  174. COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
  175. LOCATE 13, 24
  176. COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
  177. LOCATE 14, 24
  178. COLOR 0: PRINT STRING$(30, 219)
  179. END SUB
  180.  
  181. SUB header
  182. first$ = ""
  183. page = page + 1
  184. LOCATE 12, 32
  185. PRINT "Printing Page:"; page
  186. LOCATE 13, 31
  187. PRINT "<Escape> to cancel"
  188. IF first$ = "" THEN
  189. XX    IF pagecol = 132 THEN LPRINT CHR$(27); CHR$(15);
  190. XX    width lprint 132
  191.    first$ = "F"
  192. END IF
  193.  
  194. LPRINT TAB(2); "Run date: "; DATE$; " "; TIME$;
  195. XX LPRINT TAB(70); "Page:"; page
  196. XX LPRINT TAB(2); "Program Name: ITEMPRT";
  197. XX LPRINT TAB(35); "ITEM MASTER"
  198. LPRINT ""
  199.  
  200. XX LPRINT TAB(2); "ITEM";
  201. XX LPRINT TAB(14); "GROUP";
  202. XX LPRINT TAB(23); "DESCRIPTION";
  203. XX LPRINT TAB(55); "LIST";
  204. XX LPRINT TAB(69); "UNIT COST"
  205.  
  206. XX LPRINT TAB(2); "NUMBER";
  207. XX LPRINT TAB(55); "PRICE";
  208. XX LPRINT STRING$(80, "=")
  209. pline = 51
  210. END SUB
  211.  
  212. SUB sortindex STATIC
  213. SHARED index() AS indextype, numofrec
  214. offset = numofrec \ 2
  215. DO WHILE offset > 0
  216.    limit = numofrec - offset
  217.    DO
  218.       switch = FALSE
  219.       FOR i = 1 TO limit
  220.          IF UCASE$(index(i).sort) > UCASE$(index(i + offset).sort) THEN
  221.             SWAP index(i), index(i + offset)
  222.             switch = i
  223.          END IF
  224.       NEXT i
  225.       limit = switch
  226.    LOOP WHILE switch
  227.    offset = offset \ 2
  228. LOOP
  229.  
  230. END SUB
  231.  
  232.